home *** CD-ROM | disk | FTP | other *** search
/ Wonky Flux Batch 2019 02 / Wonky_Flux_Batch_2019-02.zip / Wonky Flux Batch 2019-02 / 071 - EXFER 4.1 4.2.dsk / EXFER.SEG.S < prev    next >
Text File  |  2019-02-17  |  39KB  |  1,057 lines
  1.                          ; ****************************
  2.                          ;
  3.                          ;            EXfer:
  4.                          ; The Extended Transfer Module
  5.                          ;
  6.                          ;  This program is for use on
  7.                          ;  the ProDOS version of GBBS
  8.                          ;  "Pro" 1.2 or "Pro" 1.3.
  9.                          ;
  10.                          ; Written by: Mike Golaszewski
  11.                          ; (C)1986, All Rights Reserved
  12.                          ;
  13.                          ; ****************************
  14.  
  15.                          ; THIS IS NOT FREEWARE
  16.  
  17.                          ; user segment, version 4.1
  18.  
  19.                          ; created 08/22/86 - modified 12/22/87
  20.  
  21.                          ; A very warm "thank you" goes to the following people: Jerry Cline, for all
  22.                          ; of his suggestions and for providing me with a development system while out
  23.                          ; in Phoenix; Steve Playford, for giving EXfer a new home and taking some
  24.                          ; tremendous pressure off of my back; Keith Christian for his contributions,
  25.                          ; input, and all the laughs.  Of course, thanks to Greg Schaefer too.
  26.  
  27.                          ; define linkable labels
  28.  
  29.           public prompt
  30.           public send.2
  31.           public terminate
  32.  
  33.                          ; store existing variables
  34.  
  35. enter
  36.           on nocar goto terminate
  37.           print \"XT: Loading EXfer, please hold..."
  38.           store "a:variables":gosub store:clear
  39.           gosub recall:screen$=chr$(13,2)+chr$(12):xt$=chr$(13)+"XT: "
  40.           byte=ram2:v=0:f$="a2:sys.questions":gosub chkfil
  41.           close:if not(a) then v=13
  42.           f$="a1:xt.users":gosub chkfil:close:if a create f$
  43.           open #1,f$:position #1,4,un:read #1,ram2,4:close
  44.           xm=byte(0):cr=byte(2)+byte(3)*256:if not(byte(1)) then cr=250
  45.           if xm>7 pt=1:xm=xm-8
  46.           b$=right$(lc$,3)+left$(lc$,5):lc$=b$
  47.           when$=ram2+16:ed=edit(5):if not(v) goto begin
  48.           byte=ram+37:dl=byte(3)+nibble(3)*256
  49.           ul=byte(4)+nibble(4)*256:byte=ram2
  50.  
  51.                          ; check for bit map file
  52.  
  53. begin
  54.           f$="a1:xt.bitmap":gosub chkfil:close
  55.           if (not(a)) goto begin.1:else fill ed+1,255,255
  56.           create f$:open #1,f$:write #1,ed+1,255:close
  57.           f$="a1:xt.volumes":kill f$:create f$
  58.  
  59.                          ; get XMODEM type
  60.  
  61. begin.1
  62.           print screen$" ====================================="
  63.           print "= EXfer: The Extended Transfer Module ="
  64.           print '=             Version 4.1.1           ='
  65.           print "=        The Professional BBS         ="
  66.           print " ====================================="
  67.           if not(info(2)) input @2 \"Press [RETURN]..." i$:xm=3:pt=0:goto start
  68.           if byte(1) goto start
  69.           print xt$      ;:input @2 'Does your terminal program support
  70.              Ymodem "batch" transfers ? ' i$:i$=left$(i$,1)
  71.           if i$="Y" then pt=1:xm=1:print '
  72. XT:       You also need to specify the type
  73.              of XMODEM your program supports.'
  74.           print xt$'Please enter the type of Xmodem you
  75.              are using...
  76.  
  77. [1]       DOS 3.3 Xmodem (AE "Pro" DOS)
  78. [2]       ProDOS Xmodem (Point to Point, AE)
  79. [3]       A standard form of Xmodem
  80. [4]       No Xmodem drivers, ASCII only'\
  81.           input @2 "XT: Which ? " i$:if i$="" goto exit.1
  82.           a=val(i$):if (a<1) or (a>4) goto begin
  83.           if a=1 then xm=2:else if a=2 then xm=1
  84.           if a=3 then xm=0:else if a=4 then xm=3
  85.  
  86.           byte(0)=xm+(pt*8):byte(1)=1:byte(2)=cr mod 256:byte(3)=cr/256
  87.           open #1,"a1:xt.users":position #1,4,un:write #1,ram2,4:close
  88.  
  89.                          ; try to access default library
  90.  
  91. start
  92.           bb=c:gosub log:if bf$="" goto start.2
  93.           if not(b2) gosub lsec:goto exit.1
  94.  
  95.                          ; got it, enter EXfer
  96.  
  97. start.1
  98.           gosub getslt:gosub volume:goto prompt
  99.  
  100.                          ; library does not exist
  101.  
  102. start.2
  103.           if not(info(5)) print xt$;chr$(7)"Can't find default library...":goto exit.1
  104.           tone(30,30):print xt$"Source library does not exist..."
  105.           input @2 "    Create ? " i$:if i$<>"Y" goto exit.1:else goto create
  106.  
  107.                          ; get a command
  108.  
  109. prompt
  110.           on nocar goto terminate
  111.           x=(clock(2)-clock(1))/60:x$=right$("0"+str$(x),2)
  112.           if x=0 then x$="--":else if (info(5)) or (clock(1)=0) then x$="::"
  113.           free:clear key:print \"["x$"] ([?]: Help) ->";
  114.           if zz=1 then zz=0:goto command
  115.           if zz=3 goto command:else get i$:print chr$(8)" ";chr$(8);
  116.  
  117.                          ; check for normal command
  118.  
  119. command
  120.           push prompt
  121.           if (i$="B") and (pt=1) goto batch
  122.           if i$="C" goto aux
  123.           if i$="D" goto directory
  124.           if i$="F" goto search
  125.           if i$="G" goto global
  126.           if i$="H" goto aux
  127.           if i$="I" goto info
  128.           if (i$="J") or (i$="L") goto volume
  129.           if i$="K" goto aux
  130.           if i$="M" goto aux
  131.           if i$="N" goto new
  132.           if i$="Z" goto new
  133.           if i$="R" goto receive
  134.           if i$="S" goto send
  135.           if i$="T" goto hangup
  136.           if i$="V" goto aux
  137.           if i$="W" goto aux
  138.           if i$="X" or i$="Q" goto exit
  139.           if i$="Y" then c=bb:pt=0:byte(1)=0:pop:goto begin.1
  140.           if (i$="?") or (i$="/") goto menu
  141.  
  142.                          ; check for librarian command
  143.  
  144.           if not(lb) goto prompt.1
  145.           if i$="+" and (info(5)) then pt=1:return
  146.           if i$="A" and (info(5)) pop:link "a:exfer.sys","add"
  147.           if i$="E" and (info(5)) pop:link "a:exfer.sys","external"
  148.           if (i$="$") or (i$="-") pop:link "a:exfer.sys","credit"
  149.           if i$="O" pop:link "a:exfer.sys","sort"
  150.           if i$="P" pop:ob=bb:goto create
  151.           if (i$="*") and (info(5)) input @2 "ProDOS: " i$:if i$ setint(1):use "a:xdos",i$:setint("")
  152.           if (i$="#") and (info(5)) goto aux
  153.           if (i$="2") and (info(5)) pop:link "a:exfer.aux.2"
  154.                          ; not a command
  155.  
  156. prompt.1
  157.           print " "chr$(8);:return
  158.  
  159.                          ; link to the auxilliary command segment
  160.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  161.  
  162. aux
  163.           pop:link "a:exfer.aux"
  164.  
  165.                          ; display a menu
  166.                          ; ~~~~~~~~~~~~~~
  167.  
  168. menu
  169.           print screen$\\s$:l=key(1)
  170.           f$="a1:mnu.exfer":if edit(3)=79 then f$=f$+"80"
  171.  
  172. menu.1
  173.           open #1,f$:input #1,x$:setint(" ")
  174.           for l=1 to len(x$):addint(mid$(x$,l,1))
  175.           next:copy #1
  176.           a=key(0)
  177.           if a=32 goto menu.cancel
  178.           if key(3) goto menu.key
  179.           if ((lb) and (f$<>"a1:mnu.sysop")) goto menu.sys
  180.  
  181. menu.cancel
  182.           close:setint(""):return
  183.  
  184. menu.key
  185.           close:setint(""):i$=chr$(a)
  186.           zz=1:print:return
  187.  
  188. menu.sys
  189.           close:setint(""):f$="a1:mnu.sysop":goto menu.1
  190.  
  191.                          ; send a file
  192.                          ; ~~~~~~~~~~~
  193.  
  194.                          ; get name & verify it
  195.  
  196. send
  197.           if not(b3) goto lsec:else if zz=3 then zz=0:goto xsend
  198.           if pt input @2 "Use Ymodem to download batch files ? " i$:i$=left$(i$,1)
  199.           if i$="Y" print:goto batch:else zz=3:i$="S":return
  200.  
  201. xsend
  202.           input @2 "Send: " i$:if i$="" return
  203.           if (val(i$)) or (left$(i$,1)="#") gosub nread:l=l-1:goto send.x
  204.           i$=left$(i$+chr$(32,14),15):gosub read
  205.           if not(l) goto nfile
  206.  
  207. send.x
  208.           if (l<0) goto nfile
  209.           if not(byte(9)) goto unval
  210.           na$=f$:gosub name:f$=bf$+f$:gosub chkfil
  211.           if a close:goto nfile
  212.  
  213.                          ; compute time of transfer
  214.  
  215.           close:x=((byte(10)+byte(11)*256)/2)*dm
  216.           if (not(lb)) and (x>cr) print '
  217. XT:       You don'"'"'t have enough credits to
  218.              download this file.':return
  219.           if xm=3 goto send.1:else bs=byte(10)+byte(11)*256
  220.           gosub sendtime:print xt$'Estimated time of transfer is 'a'
  221.              minutes, 'c' seconds.':if clock(2)=0 goto send.1
  222.           if x<a print xt$;chr$(7)'You do not have enough time left to
  223.              download this file.':return
  224.  
  225. send.1
  226.           if xm=3 print xt$"Press [RETURN] to begin...";:get i$:print
  227.           if xm<>3 print xt$"Sending "bs" blocks..."
  228.           use "a:x.dn",xm,f$:for x=1 to 500:next
  229.  
  230.                          ; update the record
  231.  
  232. send.2
  233.           on nocar goto terminate
  234.           d=0:if not(v) then byte=ram+29:byte(2)=byte(2)+1:byte=ram2:d=1
  235.           if v=13 then dl=dl+(peek(ed+3)=255):d=(peek(ed+3)=255)
  236.           byte(18)=byte(18)+1:nb=l
  237.           if d and (not(lb)) then x=((byte(10)+byte(11)*256)/2)*dm:if dm print '
  238. XT:       'x' credits deducted.':cr=cr-x
  239.           push getslt:goto write
  240.  
  241.                          ; send batch files
  242.                          ; ~~~~~~~~~~~~~~~~
  243.  
  244. batch
  245.           if not(b3) goto lsec:else print "Send batch files..."
  246.           print '
  247. XT:       Please enter your file list now.  A blank entry will exit the selection
  248.              mode.'\:y=1:flag=ram2+21:fill ram2+20,44,0:pt=2:bs=0:d=cr
  249.  
  250.                          ; get a file name or number
  251.  
  252. batch.1
  253.           print "Enter batch file #"right$("00"+str$(y),3);
  254.           input @2 ": " i$:if i$="" goto batch.2
  255.           if (val(i$)) or (left$(i$,1)="#") gosub nread:l=l-1:goto batch.x
  256.           i$=left$(i$+chr$(32,14),15):gosub read
  257.           if not(l) print chr$(8,24)"FILE DOESN'T EXIST"chr$(7):goto batch.1
  258.  
  259.                          ; make sure file is there and validated
  260.  
  261. batch.x
  262.           if l<0 print chr$(8,24)"FILE DOESN'T EXIST"chr$(7):goto batch.1
  263.           if not(byte(9)) print chr$(8,24)"FILE MUST BE VALIDATED"chr$(7):goto batch.1
  264.           if ty$="LST" print chr$(8,24)"ADDING LIST FILES"chr$(7):goto lbatch
  265.           if lb gosub batch.d:goto batch.1
  266.  
  267.                          ; check price & see if user has enough credits
  268.  
  269.           z=((byte(10)+byte(11)*256)/2)*dm
  270.           if z>d print chr$(8,24)"INSUFFICIENT CREDITS"chr$(7):goto batch
  271.           d=d-z:gosub batch.d:goto batch.1
  272.  
  273.                          ; ::::::::::::::::::::::::::::::::
  274.                          ; we have a file macro, process it
  275.                          ; ::::::::::::::::::::::::::::::::
  276.  
  277. lbatch
  278.           gosub name:f$=bf$+f$:open #2,f$
  279.  
  280.                          ; fake an input to the user
  281.  
  282. lbatch.1
  283.           input #2,i$:if i$="" close:goto batch.1
  284.           if left$(i$,1)=";" goto lbatch.1
  285.           print "Enter batch file #"right$("00"+str$(y),3)": "i$
  286.           i$=left$(i$+chr$(32,14),15):gosub read
  287.           if not(l) print chr$(8,24)"FILE DOESN'T EXIST"chr$(7):goto lbatch.1
  288.  
  289.                          ; process what we have
  290.  
  291.           if not(byte(9)) print chr$(8,24)"FILE MUST BE VALIDATED"chr$(7):goto lbatch.1
  292.           if lb gosub batch.d:goto lbatch.1
  293.  
  294.                          ; check the price & see if user has enough credits
  295.  
  296.           z=((byte(10)+byte(11)*256)/2)*dm
  297.           if z>d print chr$(8,24)"INSUFFICIENT CREDITS"chr$(7):goto lbatch.1
  298.           d=d-z:gosub batch.d:goto lbatch.1
  299.  
  300.                          ; ::::::::::::::::::::::::::::::::
  301.                          ; ready to send files using Ymodem
  302.                          ; ::::::::::::::::::::::::::::::::
  303.  
  304.                          ; do an "estimated time of transfer" calculation
  305.  
  306. batch.2
  307.           y=y-1:if y=0 then flag=ram+22:pt=1:return
  308.           print \"XT: Send "y;:input @0 " files [Y/N] ? " i$
  309.           if i$<>"Y" then flag=ram+22:pt=1:return
  310.           bs=bs+y/4:gosub sendtime:print '
  311. XT:       Estimated time of transfer is 'a' minutes, 'c' seconds.'
  312.           if (clock(2)=0) or (x>a) goto batch.3:else print '
  313. XT:       'chr$(7)'You do not have enough time left to download these files.'
  314.           flag=ram+22:pt=1:return
  315.  
  316.                          ; search for a file that has been marked
  317.  
  318. batch.3
  319.           bs=(bs-y/8):poke ram2+20,y:print xt$'Sending 'y' files...'
  320.           for l=2 to 255:if flag(l) goto batch.4:else next:goto batch.5
  321.  
  322.                          ; found a marked file, get its ProDOS filename
  323.  
  324. batch.4
  325.           open #1,d1$:position #1,32,l
  326.           input #1,i$:input #1,ty$:read #1,ram2+9,10
  327.           close:na$=i$:gosub name:f$=bf$+f$
  328.  
  329.                          ; send the file using Ymodem
  330.  
  331.           use "a1:y.dn",f$:byte(18)=byte(18)+1
  332.           if not(v) then byte=ram+29:byte(2)=byte(2)+1:byte=ram2
  333.           if v=13 then dl=dl+1
  334.  
  335.                          ; update the "number of times downloaded" counter & search for more files
  336.  
  337.           open #1,d1$:position #1,32,l:print #1,na$
  338.           print #1,ty$:write #1,ram2+9,10:close:next
  339.  
  340.                          ; inform remote of EOT, deduct credits, reset FLAG pointer
  341.  
  342. batch.5
  343.           use "a1:y.dn":flag=ram+22:pt=1
  344.           if dm and (not(lb)) print xt$;cr-d;" credits deducted.":cr=d:d=0
  345.           return
  346.  
  347.                          ; SUBROUTINE - display & add block size, increment file counter
  348.  
  349. batch.d
  350.           z=((byte(10)+byte(11)*256)-1)*4
  351.           print chr$(8,24);i$"  ["right$("000"+str$(z),4)"]"
  352.           if flag(l+1)=0 then y=y+1:bs=bs+(byte(10)+byte(11)*256)-(byte(10)>0)
  353.           flag(l+1)=1:return
  354.  
  355.                          ; show file info
  356.                          ; ~~~~~~~~~~~~~~
  357.  
  358.                          ; get filename & look for info
  359.  
  360. info
  361.           d=0:input @2 "Info on: " i$:if i$="" return:else na$=i$
  362.           if (val(i$)) or (left$(i$,1)="#") gosub nread:l=l-1:goto info.x
  363.           i$=left$(i$+chr$(32,14),15):gosub read
  364.           if not(l) goto nfile
  365.  
  366.                          ; see if the file has information
  367.  
  368. info.x
  369.           if l<0 goto nfile:else c=byte(12)+byte(13)*256:d=byte(14)
  370.           if (not(byte(9))) and (not(lb)) goto unval
  371.           if (not(d)) and (lb or (c=un)) goto info.a
  372.           if not(d) print xt$;chr$(7)"File has no information":return
  373.  
  374.                          ; display file information
  375.  
  376. info.1
  377.           i=0
  378.           if not(info(2)) input @2 "Do you want a printout? (y/N) "i$:if i$="Y" i=5
  379.           input #msg(d),z:input #6,i$:gosub name:print \s$\
  380.           setint(1):print #i,"Filename: ";:if lb print #i,bf$;f$:else print #i,i$
  381.           copy #6,#i:setint(""):if lb or (c=un) goto info.a
  382.           return
  383.  
  384.                          ; see if info is to be added or updated
  385.  
  386. info.a
  387.           if d print xt$"Edit this information ? ";:else print '
  388. XT:       Would you like to enter a short
  389.              description of this upload ? ';
  390.           input @2 i$:i$=left$(i$,1):if i$<>"Y" return
  391.           edit(0):if d input #msg(d),a:input #6,x$\y$\z$\i$:copy #6,#8
  392.           gosub edesc:if not(edit(2)) return:else if d goto info.e
  393.           a=1:gosub findinfo
  394.  
  395.                          ; replace information
  396.  
  397. info.s
  398.           open #1,d1$:position #1,32,l+1:input #1,na$:close
  399.           kill #msg(d):print #msg(d),un:print #6,na$
  400.           print #6,"Uploader: "a1$" "a2$" [#"un"]"
  401.           print #6,"Uploaded: "date$" "time$\:copy #8,#6
  402.  
  403.                          ; update the message file & rewrite directory entry
  404.  
  405. info.b
  406.           msg(d)=255:update:open #1,d1$:position #1,32,l+1
  407.           input #1,na$:input #1,ty$:read #1,ram2+9,10:byte(14)=d
  408.           position #1,32,l+1:print #1,na$:print #1,ty$
  409.           write #1,ram2+9,10:close:return
  410.  
  411.                          ; info already exists
  412.  
  413. info.e
  414.           input #msg(d),a:input #6,x$\y$\z$:kill #msg(d)
  415.           print #msg(d),a:print #6,x$\y$\z$\:copy #8,#6:goto info.b
  416.  
  417.                          ; SUBROUTINE - find an empty message entry
  418.  
  419. findinfo
  420.           if msg(a) then a=a+1:else d=a:return
  421.           if a>msg(0) then d=a:return
  422.           goto findinfo
  423.  
  424.                          ; receive a file
  425.                          ; ~~~~~~~~~~~~~~
  426.  
  427.                          ; get filename & check for conflicts
  428.  
  429. receive
  430.           if not(b4) goto lsec:else if nb=255 goto dfull
  431.           if zz=3 then zz=0:goto recvx
  432.           if pt=1 input @2 "Use Ymodem to upload batch files ? " i$:i$=left$(i$,1)
  433.           if i$="Y" goto rbch:else zz=3:i$="R":return
  434.  
  435. recvx
  436.           d=0:input @2 "Receive: " i$:if i$="" return
  437.           na$=left$(i$+chr$(32,14),15):i$=na$:gosub read
  438.           gosub name:f$=bf$+f$:gosub chkfil:close
  439.           if a and not(l) goto rec.2
  440.           if lb goto rec.1:else print '
  441. XT:       'chr$(7)"Duplicate name on ProDOS volume":return
  442.  
  443.                          ; see what sysop wishes to do with duplicate
  444.  
  445. rec.1
  446.           if l then nb=l
  447.           input @0 \"XT: File exists...overwrite ? " i$
  448.           if i$<>"Y" return:else kill f$:d=byte(14)
  449.  
  450.                          ; if it's a DDD file, switch to standard XMODEM
  451.  
  452. rec.2
  453.           x$=left$(i$+chr$(32,14),15):x=xm:if x=4 goto rec.a
  454.           print xt$"Is this a compressed Dalton's Disk
  455.           input @2 "    Disintegrator file [Y/N/Q] ? " i$
  456.           if i$="Q" return
  457.           if i$="Y" then dd=1:xm=0
  458.  
  459.                          ; get the file
  460.  
  461. rec.a
  462.           create f$:print xt$"Ready to receive..."
  463.           y=clock(2):a=clock(1):clock(2)=0:use "a:x.up",xm,f$:xm=x:clock(2)=y
  464.           c=clock(1):clock(2)=y+(c-a)
  465.           if not(v) then nibble(3)=nibble(3)+1:else ul=ul+(peek(ed+3)=255)
  466.           if (v=13) and (peek(ed+3)<>255) print '
  467. XT:       The file you uploaded was received in
  468.              error and has been automatically
  469.              deleted...':kill f$:return
  470.  
  471.                          ; compute some file info
  472.  
  473.           gosub dtype:gosub size:if not(lb) then cr=cr+(a/2)*um
  474.           if um and (not(lb)) print xt$"You got "(a/2)*um" credits for this file"
  475.           gosub sfile:byte(14)=0:if dd=1 then dd=0:x=254:gosub type:ty$="DDD"
  476.  
  477.                          ; ask for a description
  478.  
  479.           on nocar goto rec.4
  480.           if d print xt$'Do you want to change the existing
  481.              file information ? ';:else print xt$'Would you like to enter a short
  482.              description of this upload ? ';
  483.           input @2 i$:i$=left$(i$,1):if i$<>"Y" goto rec.3
  484.           if d input #msg(d),a:input #6,x$\y$\z$:copy #6,#8
  485.           edit(0):gosub edesc:if not(edit(2)) goto rec.3
  486.           if d then byte(14)=d:kill #msg(d):update:goto rec.i
  487.           a=1:gosub findinfo
  488.  
  489. rec.i
  490.           kill #msg(d):print #msg(d),un:print #6,na$
  491.           print #6,"Uploader: "a1$" "a2$" [#"un"]"
  492.           print #6,"Uploaded: "date$" "time$\:copy #8,#6
  493.           msg(d)=255:update
  494.  
  495. rec.3
  496.           if d then byte(14)=d
  497.           if not(v) print xt$'If there is a problem with this
  498.              upload, use the [K] command to
  499.              delete it...'
  500.           push getslt:if nb<>byte(4) goto write:else goto update
  501.  
  502.                          ; loss of carrier - save file and then hang up
  503.  
  504. rec.4
  505.           if d then byte(12)=d
  506.           push terminate:if nb<>byte(4) goto write:else goto update
  507.  
  508.                          ; receive files using Ymodem batch
  509.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  510.  
  511. rbch
  512.           i$="":if lb input @2 '
  513. XT:       Overwrite existing files ? ' i$:if i$="" return
  514.           i$=left$(i$,1):if i$="Y" then a=255:else a=0:print '
  515. XT:       Files being uploaded may be renamed if there is a duplicate file name on
  516.              the host ProDOS volume.'
  517.           x=0:d=0:print xt$"Receiving batch; begin sending files now..."
  518.  
  519.                          ; receive a file
  520.  
  521. rbch.1
  522.           i$=chr$(32,15):use "a1:y.up",bf$,a,b,i$:if i$=chr$(32,15) goto rbch.2
  523.           na$=i$:i$=left$(i$+chr$(32,14),15):gosub read:f$=bf$+na$:na$=i$
  524.           create "a2:ul.log":open #1,"a2:ul.log":append #1
  525.           print #1,a1$" "a2$" Y-loaded "f$" into library "bb\"on "date$" "time$\
  526.           close #1
  527.           if b kill f$:tone(110,75):tone(190,75):goto rbch.1
  528.           tone(190,75):tone(110,75):p=0:if l then p=byte(14):nb=l
  529.           b=x:gosub dtype:x=b:b=a:gosub size:if um and (not(lb)) then d=d+(a/2)*um
  530.           byte(14)=p:gosub sfile:a=b:byte(14)=p:x=x+1
  531.           if nb<>byte(4) gosub write:else gosub update
  532.           gosub getslt:goto rbch.1
  533.  
  534. rbch.2
  535.           print xt$      ;x;" files received successfuly":if um and (not(lb)) print '
  536. XT:       You received 'd' credits for your batch upload':cr=cr+d
  537.           d=0:return
  538.  
  539.                          ; new file search
  540.                          ; ~~~~~~~~~~~~~~~
  541.  
  542. new
  543.           print screen$"XT: ";
  544.           if i$="N" print "Display new files...":else print "Scan files by date..."
  545.           if i$="N" then c=1:goto new.1
  546.           print xt$"Default date is "mid$(lc$,4,5);left$(lc$,3)
  547.           print xt$"Enter new date or press [RETURN] to"
  548.           input @2 "    accept default: " i$:if i$="" then i$=lc$:goto new.1
  549.           if (mid$(i$,3,1)<>"/") or (mid$(i$,6,1)<>"/") print '
  550. XT:       Please use the form: MM/DD/YY...';:get i$:print:i$="Q":goto new
  551.           c=3:i$=right$(i$,3)+left$(i$,5)
  552.  
  553. new.1
  554.           print:gosub scanvol:gosub security:x=b:print \s$:goto scanit
  555.  
  556.                          ; search for a file
  557.                          ; ~~~~~~~~~~~~~~~~~
  558.  
  559. search
  560.           b=0:input @2 "Find: " i$:if i$="" return
  561.           print:gosub scanvol:print screen$"XT: Searching for..."\" :>"i$\\s$
  562.           gosub security:c=2:x=b:goto scanit
  563.  
  564.                          ; global file list
  565.                          ; ~~~~~~~~~~~~~~~~
  566.  
  567. global
  568.           print screen$'XT: Global directory of all accessable
  569.              downloads...'\:gosub scanvol
  570.           c=4:gosub security:x=b:print \s$:goto scanit
  571.  
  572.                          ; :::::::::::::::::::::::::::::::::::::::::::
  573.                          ; subroutines for various "file scan" options
  574.                          ; :::::::::::::::::::::::::::::::::::::::::::
  575.  
  576.                          ; get a starting library number
  577.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  578.  
  579. scanvol
  580.           input @2 \"XT: Starting at library #" x$:b=0:if x$="" then b=1
  581.           if not(b) then b=val(x$):if (b<1) or (b>255) print '
  582. XT:       'chr$(7)"That library doesn't exist.":pop:return
  583.           f$="a1:xv."+str$(b):gosub chkfil:close:if not(a) return
  584.           print xt$      ;chr$(7)"Starting library doesn't exist.":pop:return
  585.  
  586.                          ; search for and display a particular file entry
  587.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  588.  
  589. scanit
  590.           b=1:ob=bb:for z=x to 255:setint(1):flag=ram2+32:y=flag(z):flag=ram+22
  591.           if key(1) then z=255:next:goto scanit.3
  592.           if y goto scanit.1:else next:goto scanit.3
  593.  
  594.                          ; log to the library and show we are examining it
  595.  
  596. scanit.1
  597.           bb=z:gosub log:if b print xt$"Scanning library #"right$("00"+str$(bb),3);
  598.           if not(b) print chr$(8,3);right$("00"+str$(bb),3);
  599.           if bf$="" then l=z:gosub biterr:next:goto scanit.3
  600.           if not(b2) next:goto scanit.3
  601.           b=0:open #1,d1$:for l=1 to byte(4):position #1,l+1,32
  602.           input #1,f$:if f$="" goto scanit.2
  603.           input #1,ty$:read #1,ram2+9,10:b$=when$
  604.           a$=right$(b$,3)+left$(b$,5):setint(1)
  605.  
  606.                          ; do necessary checks for whatever scan function we are using
  607.  
  608.           if (c=1) and (lc$<=a$ or not(byte(9))) goto scanit.d
  609.           if (c=2) and (instr(i$,f$)) goto scanit.d
  610.           if (c=3) and (i$<=a$) goto scanit.d
  611.           if (c=4) goto scanit.d
  612.           goto scanit.2
  613.  
  614.                          ; display the file entry on the screen
  615.  
  616. scanit.d
  617.           b=b+1:if b=1 print chr$(8,25);:gosub dir.h
  618.           gosub dir.e:print
  619.  
  620.                          ; we are finished, or interrupted
  621.  
  622. scanit.2
  623.           if key(1) then l=byte(4):z=255
  624.           next:close:setint(""):next
  625.  
  626. scanit.3
  627.           print:bb=ob:goto log
  628.  
  629.                          ; log to a different library
  630.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~
  631.  
  632.                          ; get new volume & see if it exists
  633.  
  634. volume
  635.           print "Go to a different library..."\xt$"Current library is #"bb
  636.           input @2 "    Go to library [?]..." i$:if i$="" return
  637.           if i$="?" goto vol.2:else a=val(i$):if (a<1) or (a>255) print '
  638. XT:       'chr$(7)"That library doesn't exist":return
  639.  
  640.                          ; try to log to library
  641.  
  642.           ob=bb:bb=a:gosub log:if bf$="" then l=bb:gosub biterr:goto vol.1
  643.           if not(b2) gosub lsec:bb=ob:goto log
  644.           print xt$"Please hold...":gosub getslt
  645.           goto directory
  646.  
  647.                          ; find out if this library is to be created
  648.  
  649. vol.1
  650.           if not(info(5)) print '
  651. XT:       'chr$(7)"That library doesn't exist...":bb=ob:goto log
  652.           tone(20,20):input @0 \"XT: Library doesn't exist...create ? " i$
  653.           if i$<>"Y" then bb=ob:goto log:else goto create
  654.  
  655.                          ; scan bit map for available libraries
  656.  
  657. vol.2
  658.           print screen$"XT: You may access the following..."\\s$\
  659.           open #1,"a1:xt.bitmap":read #1,ed+1,255:close
  660.           open #1,"a1:xt.volumes":for l=1 to 255
  661.           setint(1): x=peek(ed+l):if key(1) then l=255:next:goto vol.4
  662.           if x>34 next:goto vol.4
  663.           if not(x) goto vol.3:else if flag(x) goto vol.3
  664.           next:goto vol.4
  665.  
  666. vol.3
  667.           position #1,32,l:input #1,x$
  668.           setint(1):print "["right$("00"+str$(l),3)"]: "x$:if key(1) l=255
  669.           next
  670.  
  671.                          ; finished with list
  672.  
  673. vol.4
  674.           close:setint(""):print:clear key:goto volume
  675.  
  676.                          ; hang up
  677.                          ; ~~~~~~~
  678.  
  679.                          ; make sure user wishes to terminate call
  680.  
  681. hangup
  682.           input @2 "Hang up ? " i$:if left$(i$,1)<>"Y" return
  683.           poke ram2+32,1:goto byecon
  684.  
  685.                          ; restore GBBS variables and link to the terminate code
  686.  
  687. terminate
  688.           poke ram2+32,3:goto byecon
  689.  
  690.                          ; SUBROUTINE - restore variables & do 1.3 conversions if needed
  691.  
  692. byecon
  693.           if cr<0 then cr=0
  694.           byte=ram2:byte(0)=xm+(pt*8):byte(1)=1:byte(2)=cr mod 256:byte(3)=cr/256
  695.           open #1,"a1:xt.users":position #1,4,un:write #1,ram2,4:close
  696.           poke ram2,v:when$=ram+20:if not(v) then byte=ram+29:goto byecon.1
  697.           byte=ram+37:nibble(3)=dl/256:byte(3)=dl mod 256
  698.           nibble(4)=ul/256:byte(4)=ul mod 256
  699.  
  700. byecon.1
  701.           print '
  702.           :::::::::::::::::::::::::::::::::::::
  703. :          Exfer ver 4.1.1 Professional BBS   :
  704.           :::::::::::::::::::::::::::::::::::::'
  705.           flag=ram+22:clear:recall "a:variables":kill "a:variables":x=peek(ram2)
  706.           if x=13 then ul=byte(4)+nibble(4)*256:dl=byte(3)+nibble(3)*256
  707.           if peek(ram2+32)=1 link "a:main.seg","termin2"
  708.           if peek(ram2+32)=2 link "a:main.seg","fromsys"
  709.           if peek(ram2+32)=3 link "a:main.seg","term1"
  710.  
  711.                          ; exit back to the board
  712.                          ; ~~~~~~~~~~~~~~~~~~~~~~
  713.  
  714.                          ; make sure the user wants to exit back to the bulletin board
  715.  
  716. exit
  717.           input @2 "Exit back to the BBS ? " i$:if left$(i$,1)<>"Y" return
  718.  
  719.                          ; recall variables & add uploads & downloads
  720.  
  721. exit.1
  722.           poke ram2+32,2:goto byecon
  723.  
  724.                          ; routines to edit or create libraries
  725.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  726.  
  727. create
  728.           link "a:exfer.sys","create"
  729.  
  730.                          ; :::::::::::::::::::
  731.                          ; library subroutines
  732.                          ; :::::::::::::::::::
  733.  
  734.                          ; catalog a library
  735.                          ; ~~~~~~~~~~~~~~~~~
  736.  
  737.                          ; print directory headers
  738.  
  739. directory
  740.           print screen$:gosub dir.h
  741.           if not(b3) print "XT:"chr$(7)" Directory disallowed...":goto getslt
  742.           use "a1:xtyp",bf$
  743.  
  744.                          ; grab an entry
  745.  
  746.           open #1,d1$:for l=1 to byte(4):f$=""
  747.           position #1,32,l+1:input #1,f$:input #1,ty$
  748.           position #1,32,l+1,20:read #1,ram2+9,10:if f$="" goto dir.1
  749.           setint(1)
  750.  
  751.                          ; if its valid, print it
  752.  
  753.           gosub dir.e:print:if byte(9) goto dir.1
  754.           if (not(byte(9))) and (not(lb)) goto dir.1
  755.  
  756.                          ; update if not validated
  757.  
  758.           print chr$(7,3);"** Validate above file [y/N/k] ? ";:get i$
  759.           print chr$(8,35);chr$(32,35);chr$(8,35)
  760.           if i$="Y" position #1,32,l+1,20:print #1,chr$(255);
  761.           if i$<>"K" goto dir.1:else position #1,32,l+1:fill ram2+9,31,0
  762.           print #1,chr$(13):write #1,ram2+9,30:i$=f$:gosub name
  763.           kill f$:if l<nb then nb=l
  764.  
  765. dir.1
  766.           if key(1) then l=byte(4)
  767.           next:close:setint("")
  768.           x=peek(865)+peek(866)*256:y=peek(867)+peek(868)*256
  769.           z=x-y:print \"Kbytes Free: "left$(str$(z)+chr$(32,4),5);
  770.           print "  "     ;right$("     Kbytes Used: "+str$(y),19);
  771.           if edit(3)>39 print chr$(32,10)"Total Kbytes: "x:else print
  772.           return
  773.  
  774.                          ; :::::::::::::::::::::::::::::::
  775.                          ; "directory display" subroutines
  776.                          ; :::::::::::::::::::::::::::::::
  777.  
  778.                          ; show a directory header
  779.                          ; ~~~~~~~~~~~~~~~~~~~~~~~
  780.  
  781. dir.h
  782.           print right$("00"+str$(bb),3)": "bn$;
  783.           if edit(3)>39 print chr$(32,22)"Librarian:";
  784.           print " "right$("00"+str$(b1),3)\\" #  Filename       Type ";
  785.           if edit(3)<79 print "Size Dated Cost"\:return
  786.           print "I Size Uploaded Uploader Downloaded Credits Misc"\
  787.           return
  788.  
  789.                          ; show a directory entry
  790.  
  791. dir.e
  792.           print right$("00"+str$(l+1),3)" "f$" "ty$" ";:if edit(3)<79 goto dir.x
  793.           if byte(14) print "Y ";:else print "N ";
  794.  
  795. dir.x
  796.           x=byte(10)+byte(11)*256:print right$("   "+str$(x),4)" ";
  797.            b$=when$:a$=right$(b$,3)+left$(b$,5):y=byte(18):x=byte(12)+b yte(13)*256
  798.           if edit(3)<79 goto dir.40
  799.           if not(byte(9)) poke 50,255:print "VALIDATE";:poke 50,0
  800.           if (byte(9)) and (lc$>a$) print b$;:goto dir.c
  801.           if not(byte(9)) goto dir.c
  802.           poke 50,255:print "NEW FILE";:poke 50,0
  803.  
  804. dir.c
  805.           print " User "right$("00"+str$(x),3)" "right$(" "+str$(y),3)" times ";
  806.           x=((byte(10)+byte(11)*256)/2)*dm:print right$(" "+str$(x),7)" ";
  807.           if lc$<=a$ print "NEW";
  808.           return
  809.  
  810. dir.40
  811.           if not(byte(9)) print " VAL ";
  812.           if (lc$>a$) and (byte(9)) print left$(b$,5);:else if byte(9) print " NEW ";
  813.           x=((byte(10)+byte(11)*256)/2)*dm:if cr>=x print "$";:else print " ";
  814.           print right$("   "+str$(x),4);:return
  815.  
  816.                          ; :::::::::::::
  817.                          ; directory I/O
  818.                          ; :::::::::::::
  819.  
  820.                          ; log to a library and get some dir info
  821.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  822.  
  823. log
  824.           byte=ram2:fill ram2,32,0:bf$="":z$="a1:xv."+str$(bb)
  825.           open #1,z$:input #1,bn$:input #1,bf$
  826.           read #1,ram2,9:close:b1=byte(5)+byte(6)*256
  827.           b2=1:if byte(0) then b2=flag(byte(0))
  828.           b3=1:if byte(1) then b3=flag(byte(1))
  829.           b4=1:if byte(2) then b4=flag(byte(2))
  830.           um=byte(7):dm=byte(8):lb=(un=b1)
  831.           if info(5) then lb=1:b2=1:b3=1:b4=1
  832.           d1$="a1:xv."+str$(bb):d2$="a1:dv."+str$(bb)
  833.           if bf$ ready d2$:bf$=left$(bf$,instr(":",bf$))
  834.           return
  835.  
  836.                          ; get an empty slot
  837.                          ; ~~~~~~~~~~~~~~~~~
  838.  
  839. getslt
  840.           nb=0:open #1,d1$:for l=1 to byte(4)
  841.           position #1,32,l+1:input #1,i$
  842.           if (i$="") and (nb=0) then nb=l:l=byte(4)
  843.           next:close:if not(nb) then nb=byte(4)
  844.           return
  845.  
  846.                          ; update "number of entries" counter
  847.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  848.  
  849. update
  850.           byte(4)=byte(4)+1:open #1,d1$:print #1,bn$
  851.           print #1,bf$:write #1,ram2,9:close
  852.  
  853.                          ; write a directory entry
  854.                          ; ~~~~~~~~~~~~~~~~~~~~~~~
  855.  
  856. write
  857.           open #1,d1$:position #1,32,nb+1:print #1,na$
  858.           print #1,ty$:write #1,ram2+9,10:close
  859.           z=nb:return
  860.  
  861.                          ; read a directory entry
  862.                          ; ~~~~~~~~~~~~~~~~~~~~~~
  863.  
  864. read
  865.           open #1,d1$:for l=1 to byte(4)
  866.           position #1,32,l+1:input #1,f$
  867.           if instr(i$,f$)=1 then p=l:l=byte(4):next:l=p:goto read.1
  868.           next:close #1:l=0:return
  869.  
  870. read.1
  871.           input #1,ty$:read #1,ram2+9,10:close #1
  872.           return
  873.  
  874.                          ; read a file by slot #
  875.                          ; ~~~~~~~~~~~~~~~~~~~~~
  876.  
  877. nread
  878.           if left$(i$,1)="#" then i$=mid$(i$,2)
  879.           l=val(i$):if (l<2) or (l>253) then l=0:return
  880.           open #1,d1$:position #1,32,l
  881.           input #1,f$:if f$="" close #1:l=0:return
  882.           input #1,ty$:read #1,ram2+9,10:close #1
  883.           i$=f$:if pt=2 return:else print \"XT: [#"l"]: "i$:return
  884.  
  885. :         ::::::::::::::::::::::
  886.                          ; miscellaneous disk I/O
  887.                          ; ::::::::::::::::::::::
  888.  
  889.                          ; find the type of a file
  890.                          ; ~~~~~~~~~~~~~~~~~~~~~~~
  891.  
  892. dtype
  893.           use "a1:xtyp",f$:x=peek(ram2+32)
  894.            x$="???0TXT4PDA5BIN6ADB25AWP26ASP27SRC176OBJ177LIB178S16179R TL180EXE181"
  895.            x$=x$+"STR182RIF183NDA184CDA185SET186PNT192PIC193ANI194FNT20 0PAS239CMD240"
  896.           x$=x$+"COM245P16249BAS252VAR253REL254SYS255"
  897.           ty$="":y=instr(str$(x),x$):if y then ty$=mid$(x$,y-3,3):goto id
  898.           ty$="$"+chr$(48+x/16+((x/16)>9)*7)+chr$(48+x mod 16+((x mod 16)>9)*7)
  899.  
  900.                          ; detect Macbinary or Binary ][ formats
  901.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  902.  
  903. id
  904.           x$=right$(f$,4)
  905.           if (x$=".BNY") or (x$=".BQY") or (x$=".SQZ") then ty$=right$(x$,3):return
  906.           open #1,f$:read #1,ram2+32,3:close #1
  907.           if (byte(32)=10) and (byte(33)=71) and (byte(34)=76) then ty$="BNY"
  908.           if (ty$="???") and ((byte(32)=0) and (byte(33))) then ty$="MAC"
  909.           return
  910.  
  911.                          ; set the type of a file
  912.                          ; ~~~~~~~~~~~~~~~~~~~~~~
  913.  
  914. type
  915.           use "a1:xtyp",f$,x:return
  916.  
  917.                          ; return the size of F$ in A
  918.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~
  919.  
  920. size
  921.           open #1,f$:a=size(1)/2+1:close:return
  922.  
  923.                          ; see if file exists
  924.                          ; ~~~~~~~~~~~~~~~~~~
  925.  
  926. chkfil
  927.           open #1,f$:a=mark(1):return
  928.  
  929.                          ; ::::::::::::::::::
  930.                          ; general processing
  931.                          ; ::::::::::::::::::
  932.  
  933.                          ; setup directory entry in RAM2
  934.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  935.  
  936. sfile
  937.           byte(9)=byte(3):byte(10)=a mod 256:byte(11)=a/256
  938.           byte(12)=un mod 256:byte(13)=un/256:byte(18)=0
  939.           when$="x":if lb then byte(9)=255
  940.           return
  941.  
  942.                          ; convert to a valid ProDOS name
  943.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  944.  
  945.                          ; shorten I$ to directory length
  946.  
  947. name
  948.           if len(i$)>15 then i$=left$(i$,15)
  949.           i$=i$+chr$(1)
  950.  
  951.                          ; make sure the first char is a letter
  952.  
  953. name.0
  954.           a=asc(left$(i$,1)):if a=1 pop:return
  955.           if (a>64) and (a<91) then i$=left$(i$,len(i$)-1):goto name.1
  956.           if (a>96) and (a<123) then i$=left$(i$,len(i$)-1):goto name.1
  957.           i$=mid$(i$,2):goto name.0
  958.  
  959.                          ; remove symbols from the name
  960.  
  961. name.1
  962.           f$="":for x=1 to len(i$):a=asc(mid$(i$,x,1))
  963.           if (a>64) and (a<91) goto name.2
  964.           if (a>96) and (a<123) goto name.2
  965.           if (a>47) and (a<58) goto name.2
  966.           if a=46 goto name.2:else goto name.3
  967.  
  968.                          ; add a valid character
  969.  
  970. name.2
  971.           f$=f$+chr$(a)
  972.  
  973.                          ; if we dont have a name, return to the prompt
  974.  
  975. name.3
  976.           next:if f$="" pop:return
  977.           if len(f$)>15 then f$=left$(f$,15)
  978.           return
  979.  
  980.                          ; move security flags from EDIT(5) to RAM2+32
  981.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  982.  
  983. security
  984.           open #1,"a1:xt.bitmap":read #1,ed+1,255:close:fill ram2+32,32,0
  985.           for l=1 to 255:if peek(ed+l)>34 next:return
  986.           x=peek(ed+l):if (flag(x)) or (x=0) then flag=ram2+32:flag(l)=1:flag=ram+22
  987.           next:return
  988.  
  989.                          ; :::::::::::::::::::::::::
  990.                          ; miscellaneous subroutines
  991.                          ; :::::::::::::::::::::::::
  992.  
  993.                          ; save user's stats before CLEAR
  994.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  995.  
  996. store
  997.           clear #8:byte=ram2:byte(0)=c:byte(1)=un mod 256
  998.           byte(2)=un/256:print #8,a1$,a2$,s$,lc$:return
  999.  
  1000.                          ; recall a user's stats after CLEAR
  1001.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1002.  
  1003. recall
  1004.           c=byte(0):un=byte(1)+byte(2)*256
  1005.           input #8,a1$,a2$,s$,lc$:return
  1006.  
  1007.                          ; compute an "estimated time of transfer"
  1008.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1009.  
  1010. sendtime
  1011.           x=bs/2:x=x+x/8:bs=bs*4:c=info(2)
  1012.           if c=1 then b=x*34
  1013.           if c=4 then b=x*9
  1014.           if c=8 then b=x*4
  1015.           a=b/60:c=b mod 60:x=(clock(2)-clock(1))/60
  1016.           bs=(byte(10)+byte(11)*256-(byte(10)>0))*4
  1017.           return
  1018.  
  1019.                          ; get a file description
  1020.                          ; ~~~~~~~~~~~~~~~~~~~~~~
  1021.  
  1022. edesc
  1023.           create "a2:ul.log":open #1,"a2:ul.log":append #1
  1024.           print #1,a1$" "a2$" uploaded "f$" in library "bb\" on "date$" "time$\
  1025.           close #1
  1026.           print '
  1027. Enter     description: 'edit(3)' cols, [4K] max
  1028. [DONE]    when finished, [.H] for help'
  1029.           edit(1):return
  1030.  
  1031.                          ; update errant bit-map
  1032.                          ; ~~~~~~~~~~~~~~~~~~~~~
  1033.  
  1034. biterr
  1035.           open #1,"a1:xt.bitmap":read #1,ed+1,255:close
  1036.           poke ed+l,255:open #1,"a1:xt.bitmap"
  1037.           write #1,ed+1,255:close:open #1,"a1:xt.volumes"
  1038.           position #1,32,l:print #1,chr$(13):close
  1039.           return
  1040.  
  1041.                          ; ::::::::::::::
  1042.                          ; error messages
  1043.                          ; ::::::::::::::
  1044.  
  1045. lsec
  1046.           print \xt$     ;chr$(7)" Security too low...":return
  1047.  
  1048. dfull
  1049.           print xt$      ;chr$(7)" Directory full...":return
  1050.  
  1051. nfile
  1052.           print xt$      ;chr$(7)" No such file...":return
  1053.  
  1054. unval
  1055.           print xt$      ;chr$(7)' File must be validated before it
  1056.              can be accessed...':return
  1057.